unit vdbg.win.helpers;

interface

{$mode delphi}

uses
  SysUtils,
  Windows,
  LCLProc;

{$ALIGN ON}
{$MINENUMSIZE 4}

{$region 'psapi'}
const
  PSAPI = 'psapi.dll';

function GetMappedFileName(
  hProcess: THandle;
  lpv: LPVOID;
  lpFilename: LPTSTR;
  nSize: DWORD): DWORD; stdcall;
  external PSAPI name {$IFDEF UNICODE}'GetMappedFileNameW'{$ELSE}'GetMappedFileNameA'{$ENDIF};

// http://msdn.microsoft.com/en-us/library/windows/desktop/ms683198(v=vs.85).aspx
// since Windows XP
function GetModuleFileNameExA(
  hProcess: HANDLE;   // _In_
  hModule: HMODULE;   // _In_opt_
  lpFilename: PAnsiChar; // _Out_
  nSize: DWORD        // _In_
  ): DWORD; stdcall;
  external PSAPI name 'GetModuleFileNameExA';

function GetModuleFileNameExW(
  hProcess: HANDLE;   // _In_
  hModule: HMODULE;   // _In_opt_
  lpFilename: PWideChar; // _Out_
  nSize: DWORD        // _In_
  ): DWORD; stdcall;
  external PSAPI name 'GetModuleFileNameExW';


function GetProcessImageFileNameW(hProcess: HANDLE; lpImageFileName: LPWSTR;
  nSize: DWORD ): DWORD; stdcall;
    external PSAPI name 'GetProcessImageFileNameW';
{$endregion}

function GetFileNameFromHandle(hFile: THandle): string;

// http://msdn.microsoft.com/en-us/library/windows/desktop/ms679298(v=vs.85).aspx
function DebugBreakProcess(Process: HANDLE): BOOL; stdcall;
  external kernel32;

// http://msdn.microsoft.com/en-us/library/windows/desktop/ms679307(v=vs.85).aspx
function DebugSetProcessKillOnExit(KillOnExit: BOOL): BOOL; stdcall;
  external kernel32;

// http://msdn.microsoft.com/en-us/library/windows/desktop/ms679296(v=vs.85).aspx
function DebugActiveProcessStop(dwProcessId: DWORD): BOOL; stdcall;
  external kernel32;

function OpenThread(dwDesiredAccess: DWORD; bInheritHandle: BOOL;
  dwThreadId: DWORD): HANDLE; stdcall;
  external kernel32;

// Admin rights may be needed.
function SetPrivilegeByName(const AName: string; AState: boolean): boolean;

{$region 'TlHelp32'}
const
  TH32CS_SNAPPROCESS  = $00000002;

function CreateToolhelp32Snapshot(dwFlags: DWORD; th32ProcessID: DWORD): HANDLE; stdcall;
  external kernel32;

type
  {
  tagPROCESSENTRY32A = record
    dwSize: DWORD;
    cntUsage: DWORD;
    th32ProcessID: DWORD;
    th32DefaultHeapID: ULONG_PTR;
    th32ModuleID: DWORD;
    cntThreads: DWORD;
    th32ParentProcessID: DWORD;
    pcPriClassBase: LONG;
    dwFlags: DWORD;
    szExeFile: array [0 .. MAX_PATH - 1] of AnsiChar;
  end;
  }

  tagPROCESSENTRY32W = record
    dwSize: DWORD;
    cntUsage: DWORD;
    th32ProcessID: DWORD;
    th32DefaultHeapID: ULONG_PTR;
    th32ModuleID: DWORD;
    cntThreads: DWORD;
    th32ParentProcessID: DWORD;
    pcPriClassBase: LONG;
    dwFlags: DWORD;
    szExeFile: array [0 .. MAX_PATH - 1] of WideChar;
  end;

//function Process32FirstA(hSnapshot: HANDLE; var lppe: tagPROCESSENTRY32A): BOOL; stdcall;
//  external kernel32 name 'Process32First';

function Process32FirstW(hSnapshot: HANDLE; var lppe: tagPROCESSENTRY32W): BOOL; stdcall;
  external kernel32 name 'Process32FirstW';

//function Process32NextA(hSnapshot: HANDLE; var lppe: tagPROCESSENTRY32A): BOOL; stdcall;
//  external kernel32 name 'Process32Next';

function Process32NextW(hSnapshot: HANDLE; var lppe: tagPROCESSENTRY32W): BOOL; stdcall;
  external kernel32 name 'Process32NextW';
{$endregion}


implementation

function StartsWith(const AStr, AWith: string): boolean; inline;
begin
  Result := strlicomp(PChar(AStr), PChar(AWith), Length(AWith)) = 0;
end;

function ConvertPath(const Path: string): string;
const
  BUFSIZE = 512;
var
  szTemp: array [0 .. BUFSIZE - 1] of char;
  szName: array [0 .. MAX_PATH - 1] of char;
  i: integer;
  szDrive: string;
  name: string;
begin
  Result := Path;

  szTemp[0] := #0;
  if GetLogicalDriveStrings(BUFSIZE - 1, szTemp) <> 0 then
  begin
    i := 0;
    repeat
      // Copy the drive letter to the template string
      szDrive := szTemp[i] + ':';

      // Look up each device name
      if (QueryDosDevice(PChar(szDrive), szName, MAX_PATH)) <> 0 then
      begin
        name := szName;
        if StartsWith(Path, name) then
        begin
          Result := szDrive + Copy(Path, Length(name)+1, Length(Path));
          Break;
        end;
      end;

      while (i < BUFSIZE) and (szTemp[i - 1] <> #0) do
        inc(i);

    until (i >= BUFSIZE);
  end;
end;

function GetFileNameFromHandle(hFile: THandle): string;
var
  dwFileSizeHi, dwFileSizeLo: DWORD;
  hFileMap: THandle;
  pMem: Pointer;
  pszFilename: array [0 .. MAX_PATH] of char;
begin
  Result := '';

  // Get the file size.
  dwFileSizeHi := 0;
  dwFileSizeLo := GetFileSize(hFile, @dwFileSizeHi);

  if (dwFileSizeLo = 0) and (dwFileSizeHi = 0) then
    exit;

  // Create a file mapping object.
  hFileMap := CreateFileMapping(hFile, nil, PAGE_READONLY, 0, 1, nil);

  if hFileMap <> 0 then
  begin
    // Create a file mapping to get the file name.
    pMem := MapViewOfFile(hFileMap, FILE_MAP_READ, 0, 0, 1);
    if pMem <> nil then
    begin
      if GetMappedFileName(GetCurrentProcess(), pMem, pszFilename, MAX_PATH) <> 0 then
      begin
        Result := ConvertPath(pszFilename);
      end;
      UnmapViewOfFile(pMem);
    end;
    CloseHandle(hFileMap);
  end;
end;

// http://msdn.microsoft.com/en-us/library/windows/desktop/aa446619(v=vs.85).aspx
function SetPrivilege(
  hToken: HANDLE;         // access token handle
  lpszPrivilege: LPCTSTR; // name of privilege to enable/disable
  bEnablePrivilege: BOOL  // to enable or disable privilege
  ): boolean;
var
  tp: TOKEN_PRIVILEGES;
  luid: Windows.LUID;
  Status: DWORD;
begin
  if LookupPrivilegeValue(
       nil,           // lookup privilege on local system
       lpszPrivilege, // privilege to lookup
       @luid)         // receives LUID of privilege
  then
  begin
    tp.PrivilegeCount := 1;
    tp.Privileges[0].Luid := luid;
    if bEnablePrivilege then
        tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED
    else
        tp.Privileges[0].Attributes := 0;

    // Enable the privilege or disable all privileges.
    if AdjustTokenPrivileges(hToken, False, @tp, sizeof(TOKEN_PRIVILEGES), nil, nil) then
    begin
      Status := GetLastError();
      if Status = ERROR_SUCCESS then
        Exit(True);
    end;
  end;

  DebugLn(SysErrorMessage(Status));
  Exit(False);
end;

function SetPrivilegeByName(const AName: string; AState: boolean): boolean;
var
  hToken: THandle;
begin
  if not OpenProcessToken(GetCurrentProcess, TOKEN_QUERY or TOKEN_ADJUST_PRIVILEGES, hToken) then
    Exit(False);
  Result := SetPrivilege(hToken, LPCTSTR(AName), AState);
  CloseHandle(hToken);
end;

end.
